home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / IO Examples / Worm / wormshow.icl < prev    next >
Encoding:
Modula Implementation  |  1997-05-01  |  6.0 KB  |  212 lines  |  [TEXT/3PRM]
  1. implementation module wormshow
  2.  
  3. import    StdInt, StdBool, StdList, StdFunc
  4. import    deltaPicture
  5. import    wormstate
  6.  
  7. //    The drawing constants.
  8. WormBackGroundColour    :==    RGB 1.0 1.0 0.75
  9. WormFontSize            :==    12
  10. PointsPos                :== (72, 15)
  11. LifesPos                :== (255, 5)
  12. LevelPos                :== (465,15)
  13. CornerX                    :== 15
  14. CornerY                    :== 23
  15. SegSize                    :== 4
  16. CellSize                :== 10
  17.  
  18.  
  19. //    Draw the game.
  20. DrawGame :: !Level !Food !Points !Worm !Lives -> [DrawFunction]
  21. DrawGame {level,obstacles} food points worm lives
  22. =    [    EraseRectangle    ((CornerX-8,0),(CornerX+SizeX*CellSize+16,CornerY+SizeY*CellSize+16))
  23.     ,    DrawBorders
  24.     ,    DrawObstacles    obstacles
  25.     ,    DrawPoints        points
  26.     ,    DrawWorm        worm
  27.     ,    DrawFood        food
  28.     ,    DrawLevel        level
  29.     ,    DrawLives        lives
  30.     ]
  31. where
  32.     DrawObstacles :: ![Obstacle] !Picture -> Picture
  33.     DrawObstacles [] pict
  34.     =    pict
  35.     DrawObstacles obstacles pict
  36.     #    pict    = SetPenColour (RGB 0.5 0.5 0.0)    pict
  37.         pict    = seq (map DrawObstacle obstacles)    pict
  38.         pict    = SetPenColour    BlackColour            pict
  39.     =    pict
  40.     where
  41.         DrawObstacle :: !Obstacle !Picture -> Picture
  42.         DrawObstacle ((ltx,lty),(rbx,rby)) pict
  43.         =    FillRectangle ((lx,ty),(rx,by)) pict
  44.         where
  45.             lx    = CornerX+CellSize*ltx-2
  46.             ty    = CornerY+CellSize*lty-2
  47.             rx    = CornerX+CellSize*rbx+2
  48.             by    = CornerY+CellSize*rby+2
  49.     
  50.     DrawPoints :: !Points !Picture -> Picture
  51.     DrawPoints points pict
  52.     #    pict    = SetPenColour    MagentaColour    pict
  53.         pict    = MovePenTo        (x-57,y)        pict
  54.         pict    = DrawString    "Points: "        pict
  55.         pict    = SetPenColour    BlackColour        pict
  56.         pict    = DrawNewPoints    points            pict
  57.     =    pict
  58.     where
  59.         (x,y)    = PointsPos
  60.     
  61.     DrawWorm :: !Worm !Picture -> Picture
  62.     DrawWorm [head:rest] pict
  63.     #    pict    = seq (map (DrawSegment RedColour) rest)    pict
  64.         pict    = DrawSegment    GreenColour head            pict
  65.         pict    = SetPenColour    BlackColour                    pict
  66.     =    pict
  67.     
  68.     DrawLevel :: !Int !Picture -> Picture
  69.     DrawLevel level pict
  70.     #    pict    = SetPenColour        MagentaColour                pict
  71.         pict    = MovePenTo            (x-50,y)                    pict
  72.         pict    = DrawString        "Level: "                    pict
  73.         pict    = SetPenColour        BlackColour                    pict
  74.         pict    = EraseRectangle    ((x-1,y-12),(x+100,y+4))    pict
  75.         pict    = MovePenTo            LevelPos                    pict
  76.         pict    = DrawString        (toString level)            pict
  77.     =    pict
  78.     where
  79.         (x,y)    = LevelPos
  80.     
  81.     DrawLives :: !Lives !Picture -> Picture
  82.     DrawLives lives pict
  83.     |    lives<>0    = DrawLittleWorms lives                pict
  84.     #    pict        = SetPenColour    MagentaColour        pict
  85.         pict        = MovePenTo        (lx-63,ly+10)        pict
  86.         pict        = DrawString    "No more worms!"    pict
  87.         pict        = SetPenColour    BlackColour            pict
  88.     |    otherwise    = pict
  89.     where
  90.         (lx,ly)        = LifesPos
  91.         
  92.         DrawLittleWorms :: !Lives !Picture -> Picture
  93.         DrawLittleWorms lives pict
  94.         |    lives>0        = DrawLittleWorms (lives-1) (DrawLittleWorm lives pict)
  95.         #    pict        = SetPenColour    MagentaColour    pict
  96.             pict        = MovePenTo        (lx-63,ly+10)    pict
  97.             pict        = DrawString    "Worms:"        pict
  98.             pict        = SetPenColour    BlackColour        pict
  99.         |    otherwise    = pict
  100.         where
  101.             (lx,ly)        = LifesPos
  102.             
  103.             DrawLittleWorm :: !Int !Picture -> Picture
  104.             DrawLittleWorm n pict
  105.             #    pict    = SetPenSize    (4,5)        pict
  106.                 pict    = SetPenColour    RedColour    pict
  107.                 pict    = MovePenTo        (x,y)        pict
  108.                 pict    = LinePenTo        (x+9, y)    pict
  109.                 pict    = SetPenColour    GreenColour    pict
  110.                 pict    = LinePenTo        (x+10,y)    pict
  111.                 pict    = SetPenNormal                pict
  112.             =    pict
  113.             where
  114.                 x      = lx+20*(dec n / 2) 
  115.                 y      = ly+ 7*(dec n mod 2) 
  116.                 (lx,ly)= LifesPos
  117.  
  118. DrawBorders :: !Picture -> Picture
  119. DrawBorders pict
  120. #    pict    = SetPenColour    BlackColour    pict
  121.     pict    = SetPenSize    (3,3)        pict
  122.     pict    = DrawRectangle    ((CornerX-3,CornerY-3),(CornerX+SizeX*CellSize+11,CornerY+SizeY*CellSize+11))
  123.                                         pict
  124.     pict    = SetPenNormal                pict
  125. =    pict
  126.  
  127. DrawSegment :: !Colour !Segment !Picture -> Picture
  128. DrawSegment color (x,y) pict
  129. #    pict    = SetPenColour color pict
  130.     pict    = FillCircle ((CornerX+CellSize*x,CornerY+CellSize*y),SegSize) pict
  131. =    pict
  132.  
  133. EraseSegment :: !Segment !Picture -> Picture
  134. EraseSegment segment pict = DrawSegment WormBackGroundColour segment pict
  135.  
  136. DrawFood :: !Food !Picture -> Picture
  137. DrawFood {pos=(fx,fy)} pict
  138. #    pict    = SetPenColour    MagentaColour        pict
  139.     pict    = FillRectangle    ((x,y),(x+6,y+6))    pict
  140.     pict    = SetPenColour    BlackColour            pict
  141. =    pict
  142. where
  143.     x        = CornerX+CellSize*fx-3
  144.     y        = CornerY+CellSize*fy-3
  145.     
  146. EraseFood :: !Food !Picture -> Picture
  147. EraseFood {pos=(fx,fy)} pict
  148. =    EraseRectangle ((x,y),(x+6,y+6)) pict
  149. where
  150.     x        = CornerX+CellSize*fx-3
  151.     y        = CornerY+CellSize*fy-3
  152.  
  153. DrawNewPoints :: !Points !Picture -> Picture
  154. DrawNewPoints points pict
  155. #    pict    = EraseRectangle ((x-1,y-12),(x+100,y+4))    pict
  156.     pict    = MovePenTo         PointsPos                    pict
  157.     pict    = DrawString    (toString points)            pict
  158. =    pict
  159. where
  160.     (x,y)    = PointsPos
  161.  
  162.  
  163. //    Show a step of the worm.
  164. DrawStep :: !Bool !Food !Food !Points !Segment !Segment !Segment !Picture -> Picture
  165. DrawStep scored oldfood newfood points oldh head tail pict
  166. |    not scored    = DrawMove        oldh head tail    pict
  167. #    pict        = EraseFood        oldfood            pict
  168.     pict        = DrawFood        newfood            pict
  169.     pict        = DrawNewPoints    points            pict
  170.     pict        = DrawMove        oldh head tail    pict
  171. |    otherwise    = pict
  172. where
  173.     DrawMove :: !Segment !Segment !Segment !Picture -> Picture
  174.     DrawMove oldh head (0,0) pict
  175.     #    pict    = DrawSegment    RedColour             oldh pict
  176.         pict    = DrawSegment    GreenColour             head pict
  177.         pict    = SetPenColour    BlackColour                  pict
  178.     =    pict
  179.     DrawMove oldh head tail pict
  180.     #    pict    = DrawSegment    RedColour             oldh pict
  181.         pict    = DrawSegment    GreenColour             head pict
  182.         pict    = DrawSegment    WormBackGroundColour tail pict
  183.         pict    = SetPenColour    BlackColour                  pict
  184.     =    pict
  185.  
  186.  
  187. //    Close the Playfield between two levels.
  188. DrawAnimation :: !Int !Int !Picture -> Picture
  189. DrawAnimation 40 1 pict
  190. #    pict        = SetPenColour    WhiteColour    pict
  191.     pict        = DrawBorders                pict
  192.     pict        = SetPenColour    BlackColour    pict
  193. =    pict
  194. DrawAnimation n step pict
  195. |    step<0        = DrawRectangle     ((l,t),(r,b)) (
  196.                   EraseRectangle ((r,t),(x,y)) (
  197.                   EraseRectangle ((l,b),(x,y)) (
  198.                   SetPenSize     (3,3) pict)))
  199. |    otherwise    = DrawRectangle     ((l,t),(r,b)) (
  200.                   EraseRectangle ((r,t),(x-3,y)) (
  201.                   EraseRectangle ((l,b),(x,y-3)) (
  202.                   SetPenSize     (3,3) pict)))
  203. where
  204.     l            = CornerX-3
  205.     t            = CornerY-3
  206.     r            = l+w*n
  207.     b            = t+h*n 
  208.     x            = r-step*w
  209.     y            = b-step*h 
  210.     w            = (48+SizeX*CellSize)/40
  211.     h            = (48+SizeY*CellSize)/40
  212.